home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ape-ad1a / cdxvbsou.cls < prev    next >
Text File  |  1999-09-20  |  3KB  |  124 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "CDXVBSoundBuffer"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. ' WORKING!
  15.  
  16. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal source As Long, ByVal length As Long)
  17.  
  18. Public FileName As String
  19. Public m_DS As IDirectSound
  20. Public m_lpDSB As IDirectSoundBuffer
  21.  
  22. Private Sub Class_Terminate()
  23.       Set m_lpDSB = Nothing
  24.       Set m_DS = Nothing
  25. End Sub
  26.  
  27. Public Sub LoadFromDisk(fname As String, hWnd As Long)
  28.       LoadWav hWnd, m_DS, fname, m_lpDSB
  29. End Sub
  30.  
  31. Private Sub LoadWav(hWnd As Long, Lds As IDirectSound, ByVal fname As String, Ldsb As IDirectSoundBuffer)
  32.       Dim hWave As Long
  33.       Dim pcmwave As WAVEFORMATEX
  34.       Dim lngSize As Long
  35.       Dim lngPosition As Long
  36.       Dim ptr1 As Long, ptr2 As Long, lng1 As Long, lng2 As Long
  37.       Dim aByte() As Byte
  38.  
  39.       ReDim aByte(1 To FileLen(fname))
  40.       hWave = FreeFile
  41.       Open fname For Binary As hWave
  42.             Get hWave, , aByte
  43.       Close hWave
  44.       lngPosition = 1
  45.  
  46.       While Chr$(aByte(lngPosition)) + Chr$(aByte(lngPosition + 1)) + Chr$(aByte(lngPosition + 2)) <> "fmt"
  47.             lngPosition = lngPosition + 1
  48.       Wend
  49.  
  50.       CopyMemory VarPtr(pcmwave), VarPtr(aByte(lngPosition + 8)), Len(pcmwave)
  51.  
  52.       While Chr$(aByte(lngPosition)) + Chr$(aByte(lngPosition + 1)) + Chr$(aByte(lngPosition + 2)) + Chr$(aByte(lngPosition + 3)) <> "data"
  53.             lngPosition = lngPosition + 1
  54.       Wend
  55.  
  56.       CopyMemory VarPtr(lngSize), VarPtr(aByte(lngPosition + 4)), Len(lngSize)
  57.  
  58.       Dim dsbd As DSBUFFERDESC
  59.       With dsbd
  60.             .dwSize = Len(dsbd)
  61.             .dwFlags = DSBCAPS_CTRLDEFAULT
  62.             .dwBufferBytes = lngSize
  63.             .lpwfxFormat = VarPtr(pcmwave)
  64.       End With
  65.  
  66.       DirectSoundCreate ByVal 0&, Lds, Nothing
  67.       Lds.SetCooperativeLevel hWnd, DSSCL_NORMAL
  68.  
  69.       Lds.CreateSoundBuffer dsbd, Ldsb, Nothing
  70.       Ldsb.Lock 0&, lngSize, ptr1, lng1, ptr2, lng2, 0&
  71.  
  72.       CopyMemory ptr1, VarPtr(aByte(lngPosition + 4 + 4)), lng1
  73.  
  74.       If lng2 <> 0 Then
  75.             CopyMemory ptr2, VarPtr(aByte(lngPosition + 4 + 4 + lng1)), lng2
  76.       End If
  77. End Sub
  78.  
  79. Public Sub Play(dwFlags As Long)
  80.       ' An example of dwFlags may be DSBPLAY_LOOPING
  81.       m_lpDSB.Play 0, 0, dwFlags
  82. End Sub
  83.  
  84. Public Sub StopSound()
  85.       m_lpDSB.Stop
  86.       m_lpDSB.SetCurrentPosition 0
  87. End Sub
  88.  
  89. Public Sub SetVolume(VOLUME As Long)
  90.       m_lpDSB.SetVolume VOLUME
  91. End Sub
  92.  
  93. Public Function GetVolume() As Long
  94.       Dim VOL As Long
  95.  
  96.       m_lpDSB.GetVolume VOL
  97.       
  98.       GetVolume = VOL
  99. End Function
  100.  
  101. Public Sub SetFrequency(FREQUENCY As Long)
  102.       m_lpDSB.SetFrequency FREQUENCY
  103. End Sub
  104.  
  105. Public Function GetFrequency() As Long
  106.       Dim FREQ As Long
  107.       
  108.       m_lpDSB.GetFrequency FREQ
  109.       
  110.       GetFrequency = FREQ
  111. End Function
  112.  
  113. Public Sub SetPan(PAN As Long)
  114.       m_lpDSB.SetPan PAN
  115. End Sub
  116.  
  117. Public Function GetPan() As Long
  118.       Dim PAN As Long
  119.       
  120.       m_lpDSB.GetPan PAN
  121.       
  122.       GetPan = PAN
  123. End Function
  124.